home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbmark.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-12-24  |  10.7 KB  |  327 lines
  1. (*===========================================================================*)
  2. (* Mark MSGS                                                                 *)
  3. (*                                                                           *)
  4. (*   Copyright 1988, 1989 by H. Roy Engehausen.  All rights reserved.        *)
  5. (*   This software may be freely distributed and used, but it may not        *)
  6. (*   under any circumstances be sold by anyone other than the author.        *)
  7. (*   It may be distributed by a commercial company as long as it is          *)
  8. (*   for no cost.                                                            *)
  9. (*                                                                           *)
  10. (*===========================================================================*)
  11.  
  12. {$O+}
  13.  
  14. UNIT BBMARK;
  15.  
  16. INTERFACE
  17.  
  18. PROCEDURE mark_msgs_old(command : STRING);
  19.  
  20. IMPLEMENTATION
  21.  
  22. USES
  23.   DOS,
  24.   bbdummy,
  25.   bbmem,
  26.   bbmf,
  27.   bbsdata,
  28.   bbsearch,
  29.   bbstr,
  30.   bbtime;
  31.  
  32. (*===========================================================================*)
  33. (* Procedure to mark things old                                              *)
  34. (*===========================================================================*)
  35.  
  36. PROCEDURE mark_msgs_old(command : STRING);
  37.  
  38.   VAR
  39.     code           : INTEGER;
  40.     days_to_age    : INTEGER;
  41.     date_to_age_to : LONGINT;
  42.     i              : BYTE;
  43.     invert_test    : BOOLEAN;
  44.     search_block   : search_block_type;
  45.     mark_this      : BOOLEAN;
  46.     msg_number_str : STRING[5];
  47.     msg_age        : LONGINT;
  48.     msg_age_str    : STRING[5];
  49.     type_to_use    : (unknown, mark_by_bid, mark_by_type, mark_by_search);
  50.     type_aggregate : STRING[27];
  51.     type_to_age    : STRING[27];
  52.     word_count     : BYTE;
  53.     word_to_do     : BYTE;
  54.  
  55.   (*=========================================================================*)
  56.   (* Sub procedure to check on what type of search to do                     *)
  57.   (*=========================================================================*)
  58.  
  59.   PROCEDURE do_type_select;
  60.  
  61.     BEGIN;
  62.  
  63.       (*---------------------------------------------------------------------*)
  64.       (* See which mark by we want                                           *)
  65.       (*---------------------------------------------------------------------*)
  66.  
  67.       IF type_aggregate = 'BID' THEN
  68.         BEGIN;
  69.           type_to_use := mark_by_bid;
  70.           EXIT;
  71.         END;
  72.  
  73.       IF type_aggregate = 'TYPE' THEN
  74.         BEGIN;
  75.           type_to_use := mark_by_type;
  76.           EXIT;
  77.         END;
  78.  
  79.       IF LENGTH(type_aggregate) = 1 THEN
  80.         BEGIN;
  81.           type_to_use := mark_by_search;
  82.           EXIT;
  83.         END;
  84.  
  85.       type_to_use := unknown;
  86.  
  87.       send_tnc_data_str('Invalid type of search to mark old with' + cr);
  88.  
  89.     END;
  90.  
  91.   (*=========================================================================*)
  92.   (* Sub procedure to mark a message old                                     *)
  93.   (*=========================================================================*)
  94.  
  95.   PROCEDURE do_this_msg;
  96.  
  97.     BEGIN;
  98.  
  99.       WITH search_block.search_last^.msg_i_mb DO
  100.         BEGIN;
  101.  
  102.           IF (msg_flag AND (mf_hold OR mf_old OR mf_kill)) <> 0 THEN
  103.             EXIT;
  104.  
  105.           msg_flag := msg_flag OR mf_old;
  106.           update_msg(search_block.search_last);
  107.           STR(msg_number, msg_number_str);
  108.           msg_age := (last_midnight - msg_dt_in)
  109.                                            DIV ticks_per_day;
  110.           STR(msg_age, msg_age_str);
  111.           send_tnc_data_str('Message #' + msg_number_str
  112.                             + ' marked as old after '
  113.                             + msg_age_str + ' days' + cr);
  114.         END;
  115.  
  116.     END;
  117.  
  118.   (*=========================================================================*)
  119.   (* Do by search                                                            *)
  120.   (*=========================================================================*)
  121.  
  122.   PROCEDURE do_by_search;
  123.  
  124.     BEGIN;
  125.  
  126.       command := subword(@command, 2, 0);
  127.  
  128.       set_search(command, @search_block);
  129.       IF active_tcb^.error_sw THEN
  130.         EXIT;
  131.  
  132.       search_msg(@search_block);
  133.  
  134.       WHILE search_block.search_last <> NIL DO
  135.         BEGIN;
  136.           do_this_msg;
  137.           search_msg(@search_block);
  138.         END;
  139.  
  140.       free_task_mem('MSB', TRUE);
  141.  
  142.     END;
  143.  
  144.   (*=========================================================================*)
  145.   (* Mark by age or bid                                                      *)
  146.   (*=========================================================================*)
  147.  
  148.   PROCEDURE do_type_age;
  149.  
  150.     BEGIN;
  151.  
  152.       (*---------------------------------------------------------------------*)
  153.       (* Get ready to loop thru the info                                     *)
  154.       (*---------------------------------------------------------------------*)
  155.  
  156.       type_aggregate := '';
  157.  
  158.       word_to_do := 3;
  159.  
  160.       (*---------------------------------------------------------------------*)
  161.       (* Loop thru the parms                                                 *)
  162.       (*---------------------------------------------------------------------*)
  163.  
  164.       WHILE word_to_do < word_count DO
  165.         BEGIN;
  166.  
  167.           type_to_age := subword(@command, word_to_do + 1, 1);
  168.           VAL(type_to_age, days_to_age, code);
  169.           IF (code <> 0) OR (days_to_age < 1) OR (days_to_age > 300) THEN
  170.             BEGIN;
  171.               STR(word_to_do + 1, type_to_age);
  172.               send_tnc_data_str('Invalid number of days to age -- Parm #'
  173.                                                                 + type_to_age);
  174.               EXIT;
  175.             END;
  176.  
  177.           type_to_age := subword(@command, word_to_do, 1);
  178.  
  179.           IF type_to_use = mark_by_bid THEN
  180.             BEGIN;
  181.               i := POS('_', type_to_age);
  182.               IF i <> 0 THEN
  183.                 type_to_age[i] := ' ';
  184.             END;
  185.  
  186.           IF (LENGTH(type_to_age) > 27) OR
  187.                            ((LENGTH(type_to_age) + LENGTH(type_aggregate))
  188.                                                >= SIZEOF(type_aggregate)) THEN
  189.             BEGIN;
  190.               STR(word_to_do, type_to_age);
  191.               send_tnc_data_str('Invalid message criteria to age -- Parm #'
  192.                                                                 + type_to_age);
  193.               EXIT;
  194.             END;
  195.  
  196.           invert_test := type_to_age = '*';
  197.  
  198.           date_to_age_to := last_midnight -
  199.                                         (LONGINT(days_to_age) * ticks_per_day);
  200.  
  201.           WITH search_block DO
  202.             BEGIN;
  203.  
  204.               FILLCHAR(search_block, SIZEOF(search_block), #0);
  205.  
  206.               search_last   := NIL;
  207.               search_ascend := TRUE;
  208.               search_nok    := TRUE;
  209.  
  210.               IF type_to_use = mark_by_type THEN
  211.                 BEGIN;
  212.                   search_type   := 'D';
  213.                   search_dt     := date_to_age_to;
  214.                 END;
  215.  
  216.               IF type_to_use = mark_by_bid THEN
  217.                 BEGIN;
  218.                   search_type   := '$';
  219.                   search_str    := type_to_age;
  220.                 END;
  221.  
  222.               search_msg(@search_block);
  223.  
  224.               WHILE search_last <> NIL DO
  225.                 BEGIN;
  226.  
  227.                   WITH search_last^.msg_i_mb DO
  228.                     BEGIN;
  229.  
  230.                       IF (msg_flag AND (mf_hold OR mf_old OR mf_kill)) = 0 THEN
  231.                         BEGIN;
  232.  
  233.                           IF type_to_use = mark_by_type THEN
  234.                             IF NOT invert_test THEN
  235.                               mark_this := POS(msg_type, type_to_age) <> 0
  236.                             ELSE
  237.                               mark_this := POS(msg_type, type_aggregate) = 0;
  238.  
  239.                           IF type_to_use = mark_by_bid THEN
  240.                             BEGIN;
  241.                               mark_this := msg_dt_in < date_to_age_to;
  242.                               IF NOT mark_this THEN
  243.                                 search_last := NIL;
  244.                             END;
  245.  
  246.                           IF mark_this THEN
  247.                             do_this_msg;
  248.  
  249.                         END;
  250.  
  251.                     END; (*----- End message addressing ---------------------*)
  252.  
  253.                   IF search_last <> NIL THEN
  254.                     search_msg(@search_block);
  255.  
  256.                 END; (*----- End search loop --------------------------------*)
  257.  
  258.             END;
  259.  
  260.           IF type_to_use = mark_by_type THEN
  261.             type_aggregate := type_aggregate + type_to_age;
  262.  
  263.           word_to_do := word_to_do + 2;
  264.  
  265.         END; (*----- End loop thru the parms --------------------------------*)
  266.  
  267.     END;
  268.  
  269.   (*=========================================================================*)
  270.   (* Main line                                                               *)
  271.   (*=========================================================================*)
  272.  
  273.   BEGIN;
  274.  
  275.     (*-----------------------------------------------------------------------*)
  276.     (* Break out the command                                                 *)
  277.     (*-----------------------------------------------------------------------*)
  278.  
  279.     upcase_str_var(command);
  280.  
  281.     word_count := words(command);
  282.  
  283.     IF word_count < 3 THEN
  284.       BEGIN;
  285.         send_tnc_data_str('Wrong number of parms for old message selection');
  286.         EXIT;
  287.       END;
  288.  
  289.     (*-----------------------------------------------------------------------*)
  290.     (* See which type                                                        *)
  291.     (*-----------------------------------------------------------------------*)
  292.  
  293.     type_aggregate := subword(@command, 2, 1);
  294.  
  295.     do_type_select;
  296.  
  297.     IF type_to_use = unknown THEN
  298.       EXIT;
  299.  
  300.     (*-----------------------------------------------------------------------*)
  301.     (* Do some more checking                                                 *)
  302.     (*-----------------------------------------------------------------------*)
  303.  
  304.     IF (type_to_use <> mark_by_search)
  305.                         AND ((word_count  MOD 2) <> 0) OR (word_count < 4) THEN
  306.       BEGIN;
  307.         send_tnc_data_str('Wrong number of parms for old message selection');
  308.         EXIT;
  309.       END;
  310.  
  311.     (*-----------------------------------------------------------------------*)
  312.     (* Do the search                                                         *)
  313.     (*-----------------------------------------------------------------------*)
  314.  
  315.     send_tnc_data_str('Old message search commencing' + cr);
  316.  
  317.     IF (type_to_use <> mark_by_search) THEN
  318.       do_type_age
  319.     ELSE
  320.       do_by_search;
  321.  
  322.     send_tnc_data_str('Old message search complete' + cr);
  323.  
  324.   END;
  325.  
  326. END.
  327.